perm filename SOLSYS.SAI[1,BGB] blob
sn#139439 filedate 1975-01-16 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00011 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 BEGIN "SOLSYS - A SOLAR SYSTEM SIMULATOR - SEPTEMBER 1972"
C00003 00003 SUBR ARC(REAL R,B,A)
C00005 00004 SUBR RADIAL (REAL R1,R2,W)
C00006 00005 α DATA SOURCE - ASTROPHYSICAL QUANTITIES, C.W.ALLEN, 1955
C00008 00006 REAL DATE
C00010 00007 α SIGNS OF THE ZODIAC
C00011 00008 SUBR INITIALIZATION
C00012 00009 SUBR SUNCENTERED
C00013 00010 SUBR XCENTERED(ITG J)
C00014 00011 INITIALIZATION
C00015 ENDMK
C⊗;
BEGIN "SOLSYS - A SOLAR SYSTEM SIMULATOR - SEPTEMBER 1972"
REQUIRE "ABBREV[SYS,BGB]" SOURCE_FILE;
REQUIRE "DPYIII[SYS,BGB]" SOURCE_FILE;
REQUIRE "SAITRG[SYS,BGB]" SOURCE_FILE;
DEFINE DMS(D,M,S)="(π*((S/60+M)/60+D)/180)";
SAFE ITG ARRAY DPYBUF[1:2500];
REAL XL,XH,YL,YH;
REAL BEAMX,BEAMY,MAGX,MAGY,SOX,SOY;
SUBR AI(REAL X,Y);
⊂ BEAMX←X*MAGX+SOX;
BEAMY←Y*MAGY+SOY;⊃;
SUBR AV(REAL X,Y);
BEGIN
REAL X1,Y1,X2,Y2;
X1←BEAMX;
Y1←BEAMY;
X2←BEAMX←X*MAGX+SOX;
Y2←BEAMY←Y*MAGY+SOY;
AIVECT(X1,Y1);AVECT(X2,Y2);
END;
DEFINE INCREM(I)="I←I+1";
SUBR ARC(REAL R,B,A);
BEGIN
REAL BXSAV,BYSAV; ITG RMAGX;
REAL XX,X,Y,C,S,CX,CY,D; ITG M,N,I;
BXSAV←BEAMX; BYSAV←BEAMY;
α CENTER OF THE CIRCLE;
CX ← (BEAMX-SOX)/MAGX;
CY ← (BEAMY-SOY)/MAGY;
RMAGX ← ABS(R*MAGX); IF RMAGX≤1 THEN RETURN;
α START OF ARC;
X ← COS(A)*R;
Y ← SIN(A)*R;
AI(CX+X,CY+Y);
α NUMBER OF STEPS DEPENDS ON CURVATURE AND ARC LENGTH;
M ← IF RMAGX≤4 THEN 4 ELSE
IF RMAGX≤100 THEN 12 ELSE
IF RMAGX≤400 THEN 15 ELSE 18;
N ← ABS(M*B/π) MAX 1;
α DELTA RADIANS PER STEP;
D ← B/N;
C ← COS(D);
S ← SIN(D);
α WILL THE CIRCLE BE UNBROKEN;
FOR I←1 TO N DO
BEGIN
XX ← C*X - S*Y;
Y ← C*Y + S*X; X←XX;
AV(CX+X,CY+Y);
END;
BEAMX ← BXSAV; BEAMY ← BYSAV;
END;
SUBR RADIAL (REAL R1,R2,W);
BEGIN "RADIAL"
REAL BXSAV,BYSAV;
REAL C,S,CX,CY;
BXSAV ← BEAMX; BYSAV ← BEAMY;
C ← COS(W);
S ← SIN(W);
CX ← (BEAMX-SOX)/MAGX; CY ← (BEAMY-SOY)/MAGY;
IF R1≠R2 ∧ ABS(R2-R1)≤4 THEN RETURN;
AI(CX+C*R1,CY+S*R1); IF R1=R2 THEN RETURN;
AV(CX+C*R2,CY+S*R2);
BEAMX ← BXSAV; BEAMY ← BYSAV;
END "RADIAL";
α DATA SOURCE - ASTROPHYSICAL QUANTITIES, C.W.ALLEN, 1955;
α PLANET NAMES;
PRELOAD_WITH "SUN",
"MERCURY","VENUS","EARTH",
"MARS","JUPITER","SATURN",
"URANUS","NEPTUNE","PLUTO";
STRING ARRAY PLANET[0:9];
α SEMI-MAJOR AXIS OF ORBIT IN AU'S;
PRELOAD_WITH 0,
0.387099, 0.723332, 1.000,
1.52369, 5.2028, 9.540,
19.18, 30.07, 39.44;
REAL ARRAY RADIUS[0:9];
α MEAN DAILY MOTION IN SECONDS OF ARC;
DEFINE SEC=".4848136811@-5";
PRELOAD_WITH
14732.4202*SEC, 5767.671*SEC, 3548.1926*SEC,
1886.5186*SEC, 299.1278*SEC, 120.456*SEC,
42.234*SEC, 21.53*SEC, 14.29*SEC;
REAL ARRAY SPEED[1:9];
α MEAN LONGITUDE OF PLANET AT NOON 1 JANUARY 1950;
PRELOAD_WITH
DMS(33,10,06), DMS(81,34,19), DMS(99,35,18),
DMS(144,20,07),DMS(316,09,34),DMS(158,18,13),
DMS(98,18,31), DMS(194,57,08),DMS(165,36,09);
REAL ARRAY POSITION[1:9];
REAL DATE;
ITG SECOND,MINUTE,HOUR,DAY,MONTH,YEAR;
α NAMES OF THE MONTHS;
PRELOAD_WITH
"JAN", "FEB", "MAR",
"APR", "MAY", "JUN",
"JUL", "AUG", "SEP",
"OCT", "NOV", "DEC";
STRING ARRAY NMONTH[1:12];
α LENGTH OF THE MONTHS - "30 DAYS HATH SEPTEMBER...";
PRELOAD_WITH
31,28,31, 30,30,30, 31,31,30, 31,30,31;
ITG ARRAY LMONTH[1:12];
SUBR UPDATE;
BEGIN "UPDATE"
DATE←DATE+1;
DAY←DAY+1;
IF DAY > LMONTH[MONTH] THEN ⊂ DAY←1; INCREM(MONTH);⊃;
IF MONTH > 12 THEN ⊂ MONTH←1; INCREM(YEAR);
LMONTH[2]← IF (YEAR MOD 4)=0 THEN 29 ELSE 28; ⊃;
AIVECT(200,470);
DPYSST((IF DAY≤9 THEN " "ELSE"")&
CVS(DAY)&" "&NMONTH[MONTH]&" "&CVS(YEAR));
END "UPDATE";
α SIGNS OF THE ZODIAC;
PRELOAD_WITH
"ARIES ", "TAURUS", "GEMINI", "CANCER",
"LEO", "VIRGO", "LIBRA", "SCORPIO",
"SAGITTARIUS", "CAPRICORNUS", "AQUARIUS", "PISCES";
STRING ARRAY ZODIAC[1:12];
SUBR INITIALIZATION;
BEGIN
ITG I;
DPYSET(DPYBUF);
MAGX ← MAGY ← 1;
FOR I←1 TO 9 DO ARC(50*I,2*π,0);
AIVECT(-511,-511);
AVECT(511,-511);
AVECT(511,511);
AVECT(-511,511);
AVECT(-511,-511);
DPYBIG(1);
FOR I←0 TO 11 DO
⊂ AIVECT(490*COS(2*π*I/12) - 5*LENGTH(ZODIAC[I+1]),
490*SIN(2*π*I/12));
DPYSST(ZODIAC[I+1]);⊃;DPYBIG(2);
DPYOUT(0);
FOR I←1 TO 50 DO OUTSTR(↓);
DAY←1; MONTH←1; YEAR←1950;
END;
SUBR SUNCENTERED;
BEGIN
ITG I; REAL C,S,W;
AIVECT(0,0);DPYSST("SUN");
FOR I←1 TO 9 DO
BEGIN
W ← POSITION[I];
C ← COS(W)*50*I;
S ← SIN(W)*50*I;
AIVECT(C-4,S);AVECT(C+4,S);
AIVECT(C,S-4);AVECT(C,S+4);
AIVECT(C,S);
DPYSST(PLANET[I]);
END;
END;
SUBR XCENTERED(ITG J);
BEGIN
REAL X,Y,X0,Y0,W,R; ITG I;
X0 ← COS(POSITION[J])*RADIUS[J];
Y0 ← SIN(POSITION[J])*RADIUS[J];
AIVECT(0,0);DPYSST(PLANET[J]);
PLANET[J] ↔ PLANET[0];
RADIUS[J] ↔ RADIUS[0];
FOR I←1 TO 9 DO
BEGIN
W ← POSITION[I];
X ← COS(W)*RADIUS[I] - X0;
Y ← SIN(W)*RADIUS[I] - Y0;
R ← (I*50)/SQRT(X↑2 + Y↑2);
X ← X*R; Y ← Y*R;
AIVECT(0,0);AVECT(X,Y);DPYSST(PLANET[I]);
END;
PLANET[J] ↔ PLANET[0];
RADIUS[J] ↔ RADIUS[0];
END;
INITIALIZATION;
WHILE TRUE DO
BEGIN
ITG I,CHR,ICHR; REAL C,S,W;
IF CHR=0 THEN CHR←"S";
DPYSET(DPYBUF);
IF CHR="S" THEN SUNCENTERED ELSE XCENTERED(CHR LAND '17);
FOR I←1 TO 9 DO POSITION[I] ← POSITION[I]+SPEED[I];
UPDATE;
DPYOUT(1);
ICHR ← INCHRS; IF ICHR>0 THEN CHR←ICHR;
END;
END;